#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0"  ${1+"$@"}
#-------------------------------------------------------------------------------
# Program: PuttyKnife VPN
# Module:  connect - Tcl/Tk/Expect connection manager
# Lang:    ActiveTCL 8.4.x
# Desc:    PuttyKnife is PuTTY/ssh-based virtual private network
# Author:  Rob A. Shinn
#
# Legal:    Copyright 2008 Rob A. Shinn. All rights reserved.
#           This program is free software; you can redistribute it and/or modify
#           it under the terms of the GNU General Public License as published by
#           the Free Software Foundation; either version 3 of the License, or
#           (at your option) any later version.
#
#           This program is distributed in the hope that it will be useful,
#           but WITHOUT ANY WARRANTY; without even the implied warranty of
#           MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#           GNU General Public License for more details.
#-------------------------------------------------------------------------------
# This is probably the worst Tcl code you've ever seen in your
# life. Feel free to make it more Tcl-ish. ;)

package require Expect
package require cmdline 1.2.0

variable hostname ""
variable username ""
variable password ""
variable keyfile ""
variable local_tunnels {}
variable remote_tunnels {}
variable port -1
variable ip_version -1
variable compression "false"
variable socks_port -1
variable x11 "false"
variable pty "true"
variable agentfwd "false"
variable agent "true"
variable shell "true"
variable timeout -1

proc parse_cmdline argv {
	set options {
		{H.arg ""	"hostname"}
		{U.arg ""	"username"}
		{p.arg ""	"password"}
		{k.arg ""	"keyfile"}
		{P.arg -1	"port"}
		{i.arg -1	"ip version"}
		{C			"compression"}
		{D.arg -1	"dynamic socks port"}
		{X			"X11 forwarding"}
		{a			"agent forwarding"}
		{N			"no shell"}
		{T			"no pty" }
		{agent		"use agent" }
		{noagent	"don't use agent"}
		{L.arg ""	"local tunnel"}
		{R.arg ""	"remote tunnel"}
		{pm.arg ""  "proxy method"}
		{pu.arg ""  "proxy username"}
		{pp.arg ""  "proxy password"}
		{ph arg ""  "proxy hostname"}
		{pn.arg -1  "proxy port number"}
		{pc.arg ""  "proxy command" }
		
	}
	set usage ": connect.tcl \[options] ...\noptions:"
	array set params [::cmdline::getoptions argv $options $usage]
	if { $params(a) } { set ::agentfwd "true" }
	if { $params(N) } { set ::shell "false" }
	if { $params(T) } { set ::pty "false"}
	if { $params(X) } { set ::x11 "true" }
	if { $params(C) } { set ::compression "true" }
	if { $params(agent) }  { set ::agent "true" }
	if { $params(noagent) } { set ::agent "false" }

	set has_h [expr {[string length $params(H)] > 0}]
	set has_u [expr {[string length $params(U)] > 0}]
	set has_p [expr {[string length $params(p)] > 0}]
	set has_k [expr {[string length $params(k)] > 0}]
	set has_i [expr {[string length $params(i)] > 0}]
	set has_L [expr {[string length $params(L)] > 0}]
	set has_R [expr {[string length $params(R)] > 0}]
	set has_P [expr {$params(P) >= 0}]
	set has_D [expr {$params(D) >= 0}]
	if $has_h { 
		set ::hostname $params(H) 
	} else {
		return -code error "Must specify a hostname with -h.\n"
	}
	if $has_u { set ::username $params(U) }
	if $has_k { set ::keyfile $params(k) }
	if $has_p { set ::password $params(p) }
	if $has_L { set ::local_tunnels $params(L) }
	if $has_R { set ::remote_tunnels $params(R) }
	#if { !$has_p && !$has_k } {
	#	return -code error "Must specify either password (-p) or keyfile (-k)\n"
	#}
	if $has_i { 
		set ip $params(i)
		if { $ip == 4 || $ip == 6 } { 
			set ::ip_version $ip 
		}	
	} else { 
		return -code error "Only IP v4 or IP v6 are allowed.\n" 
	}
	if $has_P { set ::port $params(P) }
	if $has_D { set ::socks_port $params(D) }	
} 

proc get_tunnel_switches args {
	set i 0
	list switches
	set switches {}
	foreach t [lsort -dictionary [array names ::tunnels -re "source_addr.*"]] {	
		set tunnel($i) [lappend tunnel($i) $::tunnels($t)]
		incr i
	}
	set i 0
	foreach t [lsort -dictionary [array names ::tunnels -re "source_port.*"]] {	
		set tunnel($i) [lappend tunnel($i) $::tunnels($t)]
		incr i
	}
	set i 0
	foreach t [lsort -dictionary [array names ::tunnels -re "dest_addr.*"]] {
		set tunnel($i) [lappend tunnel($i) $::tunnels($t)]
		incr i
	}
	set i 0
	foreach t [lsort -dictionary [array names ::tunnels -re "dest_port.*"]] {
		set tunnel($i) [lappend tunnel($i) $::tunnels($t)]
		incr i
	}	
	foreach t [lsort -integer [array names tunnel]] {
		lappend switches "-L" [join $tunnel($t) ":"]
	}
	set arguments [join $switches " "]
	return $switches
}

proc return_password {window} {
	# password dialog callback for OK button
	set ::password [$window.e1 get]
	destroy $window
}

proc get_password args {
	# password dialog
	set w .pwentry
	catch {destroy $w}
	toplevel $w
	wm title $w "Enter Password"
	wm iconname $w "pwentry"
	set pw ""
	
	label $w.msg -wraplength 5i -justify left -text "Please enter \
	the password for the user $::username on $::hostname"
	pack $w.msg -side top
	
	frame $w.buttons
	pack $w.buttons -side bottom -fill x -pady 2m
	entry $w.e1 -show "*"
	button $w.buttons.ok -text Ok -command "return_password $w"
	button $w.buttons.cancel -text Cancel -command "destroy $w"
	pack $w.buttons.ok $w.buttons.cancel -side left -expand 1
	pack $w.e1  -side top -pady 5 -padx 10 -fill x
	
	wm withdraw $w
	update
	set x [expr {([winfo screenwidth .]-[winfo width $w])/2}]
	set y [expr {([winfo screenheight .]-[winfo height $w])/2}]
	wm geometry $w +$x+$y
	#wm transient $w .
	wm deiconify $w
	tkwait window $w
}


parse_cmdline $argv
list switches 
set switches {-v}
if { $::username == "" } { set ::username $tcl_platform(user) }
lappend switches "-load" "PuttyKnife_VPN_Session"
lappend switches "-l" $::username
# if { $::password != "" } {lappend switches  "-pw" $::password}
if { $::keyfile != "" } {lappend switches "-i" $::keyfile}
if { $::port >= 0 } { lappend switches "-P" $::port	}
if { !$::agentfwd } { lappend switches "-a" } else { lappend switches "-A"}
if { !$::shell } { lappend switches "-N" }
if { $tcl_platform(platform) == "unix" } {
	if { $::agent } { 
		lappend switches "-agent" 
	} else { 
		lappend switches "-noagent"
	}
}
if { !$::shell } { lappend switches "-N" }
if { !$::pty } { lappend switches "-T" }
if $::compression { lappend switches "-C" }
if { $::local_tunnels != {}} {
	array set ::tunnels [split $::local_tunnels ":"]
	foreach _switch [get_tunnel_switches] {
		lappend switches $_switch
	}
}
if {$::remote_tunnels != {}} {
	array set ::tunnels [split $::remote_tunnels ":"]
	foreach _switch [get_tunnel_switches] {
		lappend switches $_switch
	}
}
puts $switches
if { $::socks_port >= 0 } {lappend switches "-D" $::socks_port}
if $::x11 { lappend switches "-X" }
set cmd "plink"
lappend switches $::hostname
set arguments [join $switches " "] 
if { $::password != "" } { 
	set arguments [string map "$::password xxxx" $arguments] 
} 
# we want 
package require Tk
wm withdraw .
puts "Launching command: $cmd $arguments \n"
#exp_stty echo
set pid [eval exp_spawn $cmd $switches]
set id $spawn_id
set child_tty [info vars tty_spawn_id]
while 1==1 {
	expect -i $id timeout {
		 	return -code error -errorcode 30 "\nConnection timed out!"
		} eof {
			return -code error -errorcode 5 "\nConnection terminated!"
		} -re "password: $" {
			get_password
			exp_send "$::password\r"
		} -re "Store .* $" {
			set r [tk_dialog .store "Unknown host key" "Store the host key for $::hostname in the cache?" questhead 0 Yes No]
			if { $r == 0 } {
				exp_send -i $id "y\r"
			} else {
				exp_send -i $id "n\r"
				return -code error "\nNo host key!"
			}
		} "Update cached key? (y/n, Return cancels connection)" {
			set r [tk_dialog .store "Invalid host key!" "WARNING: \  
		     POSSIBLE MAN-IN-THE-MIDDLE ATTACK!  \
			 The host for $::hostname differs from the key stored in the cache.\
			 You should only update the cached key if you know the host key has\
			 changed. Update?" \
			 questhead 0 "Yes: Update" "No/Cancel connection" ]
			if { $r == 0 } {
				exp_send -i $id "y\r"
			} else {
				exp_send -i $id "\r"
				return -code error "\nBad host key! Bailing..."
			}
		} "Opened channel for session" {
			puts "Connection is stable."
  		} -re "..*" {
			exp_continue
	}
}
